home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / uim / im-switcher.scm < prev    next >
Encoding:
Text File  |  2010-11-07  |  6.0 KB  |  180 lines

  1. ;;; im-switcher.scm: Action-based IM switcher
  2. ;;;
  3. ;;; Copyright (c) 2006-2009 uim Project http://code.google.com/p/uim/
  4. ;;;
  5. ;;; All rights reserved.
  6. ;;;
  7. ;;; Redistribution and use in source and binary forms, with or without
  8. ;;; modification, are permitted provided that the following conditions
  9. ;;; are met:
  10. ;;; 1. Redistributions of source code must retain the above copyright
  11. ;;;    notice, this list of conditions and the following disclaimer.
  12. ;;; 2. Redistributions in binary form must reproduce the above copyright
  13. ;;;    notice, this list of conditions and the following disclaimer in the
  14. ;;;    documentation and/or other materials provided with the distribution.
  15. ;;; 3. Neither the name of authors nor the names of its contributors
  16. ;;;    may be used to endorse or promote products derived from this software
  17. ;;;    without specific prior written permission.
  18. ;;;
  19. ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
  20. ;;; IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
  21. ;;; THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
  22. ;;; PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
  23. ;;; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  24. ;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  25. ;;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
  26. ;;; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  27. ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  28. ;;; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
  29. ;;; ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  30. ;;;;
  31.  
  32. (require "util.scm")
  33. (require "im.scm")
  34. (require "i18n.scm")
  35. (require "load-action.scm")
  36.  
  37. (define imsw-indication-id-alist
  38.   '())
  39.  
  40. (define imsw-iconic-label-alist
  41.   '((direct . "-")
  42.     (anthy  . "A")
  43.     (canna  . "C")
  44.     (wnn    . "W")
  45.     (mana   . "M")
  46.     (sj3    . "3")
  47.     (skk    . "S")
  48.     (tcode  . "T")
  49.     (tutcode . "U")
  50.     (byeoru . "B")
  51.     (anthy-utf8 . "A")
  52.     (elatin . "E")
  53.     (look   . "L")))
  54.  
  55. (define imsw-default-iconic-label "IM")
  56.  
  57. (define imsw-indication-id
  58.   (lambda (idname)
  59.     (or (assq-cdr idname imsw-indication-id-alist)
  60.     idname)))
  61.  
  62. (define imsw-iconic-label
  63.   (lambda (idname)
  64.     (or (assq-cdr idname imsw-iconic-label-alist)
  65.     imsw-default-iconic-label)))
  66.  
  67. ;; FIXME: the helper protocol must be revised as codeset included
  68. ;; in each branches, to make the switcher widget context-encoding
  69. ;; independent.
  70. (define imsw-actions
  71.   (lambda ()
  72.     (if (not (memq 'direct enabled-im-list))
  73.     (set! enabled-im-list (append enabled-im-list '(direct))))
  74.     (filter-map
  75.      (lambda (idname)
  76.        (let ((im (assq idname im-list)))
  77.      (and im
  78.           (let* ((act-name (symbolconc 'action_imsw_ idname))
  79.              (indication (list (imsw-indication-id idname)
  80.                        (imsw-iconic-label idname)
  81.                        (im-name-label im)
  82.                        (im-short-desc im))))
  83.         (register-action act-name
  84.                  (lambda (ctx) ;; indication handler
  85.                    indication)
  86.  
  87.                  (lambda (ctx) ;; activity predicate
  88.                    (eq? (im-name (context-im ctx))
  89.                     idname))
  90.  
  91.                  (lambda (ctx) ;; action handler
  92.                    (im-switch-im ctx idname)
  93.                    (case imsw-coverage
  94.                      ((focused-context)
  95.                       #t)
  96.  
  97.                      ((app-global)
  98.                       (im-switch-app-global-im ctx idname))
  99.  
  100.                      ((system-global)
  101.                       (im-switch-system-global-im ctx idname)))))
  102.         act-name))))
  103.      enabled-im-list)))
  104.  
  105. (define imsw-widget-codeset
  106.   (or (and (feature? 'nls)
  107.        (bind-textdomain-codeset (gettext-package) #f))
  108.       (locale-codeset (locale-new ""))))
  109.  
  110. ;; This procedure must be called after all IM entries are prepared in
  111. ;; im-list. So the invocation is defferred to
  112. ;; imsw-add-im-switcher-widget or context-refresh-switcher-widget!.
  113. (define imsw-register-widget
  114.   (lambda ()
  115.     (or (assq 'widget_im_switcher widget-proto-list)
  116.     (let ((acts (imsw-actions)))
  117.       (register-widget 'widget_im_switcher
  118.                (activity-indicator-new acts)
  119.                (actions-new acts))))))
  120.  
  121. (define imsw-add-im-switcher-widget
  122.   (lambda (widget-id-list)
  123.     (if toolbar-show-action-based-switcher-button?
  124.     (begin
  125.       (imsw-register-widget)
  126.       (if (memq 'widget_im_switcher widget-id-list)
  127.           widget-id-list
  128.           (cons 'widget_im_switcher widget-id-list)
  129.           ;;(append widget-id-list '(widget_im_switcher))
  130.           ))
  131.     (delete 'widget_im_switcher widget-id-list eq?))))
  132.  
  133. (define context-init-widgets-orig context-init-widgets!)
  134. (define context-init-widgets!
  135.   (lambda (context widget-id-list)
  136.     (context-init-widgets-orig context
  137.                    (imsw-add-im-switcher-widget widget-id-list))))
  138.  
  139. (define context-list-replace-widgets-orig context-list-replace-widgets!)
  140. (define context-list-replace-widgets!
  141.   (lambda (target-im-name widget-id-list)
  142.     (context-list-replace-widgets-orig
  143.      target-im-name
  144.      (imsw-add-im-switcher-widget widget-id-list))))
  145.  
  146. (define context-update-widget-states-orig context-update-widget-states!)
  147. (define context-update-widget-states!
  148.   (lambda (context act-ids)
  149.     (if toolbar-show-action-based-switcher-button?
  150.     (for-each widget-activate!
  151.           (cdr (context-widgets context))
  152.           (cdr act-ids))
  153.     (context-update-widget-states-orig context act-ids))))
  154.  
  155. (define widgets-refresh-switcher-widget
  156.   (lambda (widgets ctx)
  157.     (if toolbar-show-action-based-switcher-button?
  158.     (begin
  159.       (imsw-register-widget)
  160.       (if (and
  161.         (pair? (car widgets))
  162.         (assq 'widget_im_switcher widgets))
  163.           widgets
  164.           (cons (widget-new 'widget_im_switcher ctx)
  165.             widgets)))
  166.     (alist-delete 'widget_im_switcher widgets eq?))))
  167.  
  168. (define context-refresh-switcher-widget!
  169.   (lambda (ctx)
  170.     (let ((toggle-state (context-toggle-state ctx))
  171.       (widgets (context-widgets ctx)))
  172.       (context-set-widgets! ctx (widgets-refresh-switcher-widget widgets ctx))
  173.       (if toggle-state
  174.       (let ((alt-widgets (toggle-state-widget-states toggle-state)))
  175.         (toggle-state-set-widget-states!
  176.          toggle-state
  177.          (widgets-refresh-switcher-widget alt-widgets ctx))))
  178.       (if (context-focused? ctx)
  179.       (context-propagate-widget-configuration ctx)))))
  180.